perm filename MARKER.SAI[1,BGB] blob
sn#001253 filedate 1972-10-22 generic text, type T, neo UTF8
00100 ENTRY MARKER,SHOWFE;
00200 BEGIN "MARKER"
00300 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400 REQUIRE "DDSUBR.HDR[DD,BGB]" SOURCE_FILE;
00500 REQUIRE "ARRAYS.HDR[SYS,BGB]" SOURCE_FILE;
00600 REQUIRE "COMMON[IA,BGB]" SOURCE_FILE;
00700 REQUIRE "DDCALL.HDR[DD,BGB]" SOURCE_FILE;
00100 α MAIL SUBROUTINE LINKAGE TO CORRELATOR;
00200 INTEGER MYJOB#,SUBJOBNAME,LTRPTR;
00300 SAFE INTEGER ARRAY LETTER[0:31];
00400 DEFINE MAIL = "'710000000000";
00500
00600 PROCEDURE CORELRUN;
00700 BEGIN "CORELRUN"
00800 STRING STR; INTEGER LINE;
00900 START_CODE MOVE SUBJOBNAME;'047000400043;SKIPA;POPJ '17,;END;
01000 LINE ← PTYGET;
01100 PTOSTR(LINE,"L"&↓);STR←PTYSTR(LINE,"L");STR←PTYSTR(LINE,"#");
01200 PTOSTR(LINE,"COR/BGB"&↓);
01300 STR←PTYSTR(LINE,"B");STR←PTYSTR(LINE,"B");STR←PTYSTR(LINE,".");
01400 PTOSTR(LINE,"RU COREL"&↓);CALL(2,"SLEEP");STR←PTYSTR(LINE,"*");
01500 END "CORELRUN";
01600
01700 PROCEDURE CORELCALL;
01800 START_CODE "CORELCALL"
01900 LABEL L1,L2;
02000 SKIPE 1,MYJOB#;
02100 JRST L1;
02200 α INITIALIZATION;
02300 '047040000030;
02400 MOVEM 1,MYJOB#;
02500 MOVE ['435762455400];
02600 MOVEM SUBJOBNAME;
02700 '047000400043;
02800 PUSHJ '17,CORELRUN;
02900 MOVE LETTER;
03000 HRRZM LTRPTR;
03100 HRRM L2;
03200 MOVE 1,MYJOB#;
03300 α SEND A COMMAND AND ARGUMENTS LETTER;
03400 L1: MOVEM 1,@LTRPTR;
03500 MAIL SUBJOBNAME;
03600 JRST 4,;
03700 α WAIT FOR THE RESULTS LETTER;
03800 L2: MAIL 1,
03900 END "CORELCALL";
00100 INTERNAL PROCEDURE MARKER;
00200 BEGIN "MARKER"
00300 INTEGER ARRAY ITEMVAR FWN;
00400 STRING STR;
00500 INTEGER FLG,X,Y,MAGNIF,CYC;
00600 SHORT REAL MX,MY,MR,MDX,MDY;
00700 SHORT REAL ARRAY ∂F[1:5],∂FWN[1:5];
00800 SHORT REAL ARRAY ITEMVAR F;
00900
01000
01100 PROCEDURE RETICLE;
01200 BEGIN "RETICLE"
01300 GETBI;
01400 IF CYC LAND 1 THEN
01500 BEGIN "RECTANGLE"
01600 AI(MX-MDX,MY-MDY);
01700 AV(MX+MDX,MY-MDY);
01800 AV(MX+MDX,MY+MDY);
01900 AV(MX-MDX,MY+MDY);
02000 AV(MX-MDX,MY-MDY);
02100 END "RECTANGLE";
02200 DOT(MX,MY); α CROSS HAIRS;
02300 AI(MX+2,MY);
02400 AV(MX+4,MY);
02500 AI(MX-2,MY);
02600 AV(MX-4,MY);
02700 AI(MX,MY+2);
02800 AV(MX,MY+4);
02900 AI(MX,MY-2);
03000 AV(MX,MY-4);
03100 IF CYC LAND 2 THEN
03200 BEGIN "CIRCLE"
03300 AI(MX,MY);
03400 ARC(MR,2*π,0);
03500 END "CIRCLE";
03600 GETDD;
03700 PLOWIN;
03800 RELARY(BIBUF);
03900 SETCHN(1);
04000 ERASDD(1);
04100 SHOWDD;
04200 RELARY(DDBUF);
04300 END "RETICLE";
00100 PROCEDURE AUTOCORRELATION;
00200 BEGIN "ACOREL"
00300 INTEGER FLG,DM,DN,TIME1,TIME2,NCNT,SIZ3;
00350 REAL RMAX,MAXRAD,AVGRAD,THRESH;
00400 TVSEG.(CVIS(TVFILE,FLG),1); α GET PROBE SEGMENT OFF DRUM;
00500 LETTER[1]←LETTER[2]←LETTER[3]←0;
00600 α PROBE WINDOW;
00700 LETTER[4]← 107 - (MY+MDY-1);
00800 LETTER[5]← 144 + (MX-MDX);
00900 LETTER[6]← 2*MDY;
01000 LETTER[7]← 2*MDX;
01100 α TARGET WINDOW;
01200 LETTER[8]← 107 - (∂(SWINDO)[2]+∂(SWINDO)[4]-1);
01300 LETTER[9]← 144 + (∂(SWINDO)[1]-∂(SWINDO)[3]);
01400 LETTER[10]← 2*∂(SWINDO)[4];
01500 LETTER[11]← 2*∂(SWINDO)[3];
01501 α SIZE OF RESULTS;
01502 DM ← LETTER[10] - LETTER[6];
01503 DN ← LETTER[11] - LETTER[7];
01504 SIZ3 ← (DM+1)*(DN+1);
01600 α THRESHOLD;
01700 OPEN(2,"TTY",0,1,0,30,0,0);
01800 OUTSTR(↓&9&"THRESHOLD = ");
01900 THRESH ← REALIN(2);
02000 RELEASE(2);
02100 QUICK_CODE
02200 MOVE 11,LETTER;
02300 MOVE 12,THRESH;
02400 MOVEM 12,12(11);
02500 END;
02600 CORELCALL;
02700 START_CODE
02800 MOVE 1,LETTER;
02900 MOVE 15(1); MOVEM RMAX;
03000 MOVE 16(1); MOVEM NCNT;
03100 MOVE 17(1); MOVEM MAXRAD;
03200 MOVE 18(1); MOVEM AVGRAD;
03300 MOVE 19(1); MOVEM TIME1;
03400 MOVE 20(1); MOVEM TIME2;
03500 END;
03700 OUTSTR(9&CVS(NCNT*100%SIZ3)&"% ABOVE THRESHOLD.");
03701 OUTSTR(9&"NCNT = "&CVS(NCNT)&↓);
03800 OUTSTR(9&"MAXRAD = "&CVG(MAXRAD)&9);
03900 OUTSTR("AVGRAD = "&CVG(AVGRAD)&↓);
04200 SETFORMAT(0,3);
04300 OUTSTR(9&"RUN TIME "&CVS(TIME1%60000)&":"&CVF((TIME1 MOD 60000)/1000)&↓);
04400 OUTSTR(9&"REAL TIME "&CVS(TIME2%60000)&":"&CVF((TIME2 MOD 60000)/1000)&↓);
04500 OUTSTR(9&"TIME SHARE"&9&CVS(100*TIME1/TIME2)&" %"&↓);
04600 SETFORMAT(0,7);
04700 END "ACOREL";
00100 α INIT THE DDSUBR AND BIBUF;
00200 WNFRAM(216,288,0,0,480,512);
00300 WNCLIP(∂(SWINDO),∂(OWINDO),∂(OWINDO)[3]);
00400 α OBTAIN INITIAL RETICLE FROM THE SOURCE WINDOW;
00500 MX ← ∂(SWINDO)[1];
00600 MY ← ∂(SWINDO)[2];
00700 MDX ← ∂(SWINDO)[3]/2;
00800 MDY ← ∂(SWINDO)[4]/2;
00900 MR ← ∂(SWINDO)[3]/4;
01000 α POSITION THE RETICLE;
01100 BEGIN "POSITION"
01200 INTEGER CHR,CTRL;
01300 SHORT REAL DEL;
01400 DEL ← 1.0;
01500 CYC ← 0;
01600 WHILE TRUE DO
01700 BEGIN
01800 LABEL L1,L2;
01900 RETICLE;
02000 L1: CHR ← INCHRW;
02100 CTRL ← CHR LAND '200;
02200 CHR ← CHR LAND '177;
02300 IF CHR="/" THEN DEL←DEL/2 ELSE
02400 IF CHR="\" THEN DEL←DEL*2 ELSE
02500 IF CHR="A" THEN AUTOCORRELATION ELSE
02600 IF CHR=13 THEN OUTSTR(".") ELSE GO L2;GO L1;L2:
02700 IF CTRL THEN
02800 IF CHR=";" THEN MDX←MDX-DEL ELSE
02900 IF CHR=":" THEN MDX←MDX+DEL ELSE
03000 IF CHR="(" THEN MDY←MDY-DEL ELSE
03100 IF CHR=")" THEN MDY←MDY+DEL ELSE GO L1
03200 ELSE
03300 IF CHR="." THEN CYC←CYC+1 ELSE
03400 IF CHR=";" THEN MX←MX-DEL ELSE
03500 IF CHR=":" THEN MX←MX+DEL ELSE
03600 IF CHR="(" THEN MY←MY-DEL ELSE
03700 IF CHR=")" THEN MY←MY+DEL ELSE
03800 IF CHR="-" THEN MR←ABS(MR-DEL) ELSE
03900 IF CHR="*" THEN MR←MR+DEL ELSE
04000 IF CHR='175 THEN DONE ELSE GO L1;
04100 END;
04200 END "POSITION";
04300
04400 α STASH THE POSITION INTO THE FEATURE WINDOW DATUM;
04500 ∂FWN[1]←MX;
04600 ∂FWN[2]←MY;
04700 ∂FWN[3]←MDX;
04800 ∂FWN[4]←MDY;
04900 ∂FWN[5]←MR;
00100 α NAME THAT FEATURE;
00200 OUTSTR(↓&9&"NAME = ");
00300 STR ← INCHWL;
00400 IF "A"≤STR ∧ STR≤"Z" THEN ELSE RETURN;
00500 F ← CVSI(STR,FLG);
00600 α NEW FEATURE CREATION;
00700 IF FLG THEN BEGIN F←NEW(∂F);NEW_PNAME(F,STR);PUT F IN FEASET;END;
00800 α UPDATE FEATURE WINDOW IF IT EXISTS;
00900 FLG ← TRUE;
01000 ∀ FWN|TVFILE⊗F≡FWN DO
01100 BEGIN ARRBLT(∂(FWN)[1],∂FWN[1],5);FLG←FALSE;END;
01200 α NEW FEATURE WINDOW CREATION;
01300 IF FLG THEN
01400 BEGIN FWN←NEW(∂FWN);MAKE TVFILE⊗F≡FWN;END;
01500 α PLACE FEATURE LABEL IN DD IMAGE;
01600 AI(MX+2,MY+(4/(1 LSH ∂(OWINDO)[3])));
01700 DDSTR(1,STR);
01800 OUTSTR(↓&"*");
01900 END "MARKER";
00100 α SHOW THE ACTUAL AND PROJECTED RASTER POSITIONS OF A FEATURE;
00200 INTERNAL PROCEDURE SHOWFE (BOOLEAN Q);
00300 BEGIN "SHOWFE"
00400 DEFINE THRICE="FOR I←1 STEP 1 UNTIL 3 DO";
00500 INTEGER I,FLG;
00600 REAL MX,MY;
00700 REAL ARRAY U,W[1:3],C[1:4,1:3];
00800 REAL ARRAY ITEMVAR FWN;
00900 REAL ARRAY ITEMVAR F;
01000 STRING STR;
01100 α GET THE CAMERA DATUM IF NECESSARY AND POSSIBLE;
01200 IF Q THEN
01300 BEGIN "GETCAM"
01400 REAL ARRAY ITEMVAR CAM;
01500 SET CAMS;
01600 CAMS ← LOCOR⊗TVFILE;
01700 IF LENGTH(CAMS)=0 THEN
01800 BEGIN
01900 Q←FALSE;
02000 OUTSTR("CAMERA NOT FOUND."&↓);
02100 END ELSE
02200 BEGIN
02300 CAM ← LOP(CAMS);
02400 ARRBLT(C[1,1],∂(CAM)[1,1],12);
02500 END;
02600 END "GETCAM";
02700 OUTSTR(↓);
02800 WNFRAM(216,288,0,0,480,512);
02900 WNCLIP(∂(SWINDO),∂(OWINDO),∂(OWINDO)[3]);
03000 α STROBE THE USER FOR A FEATURE NAME;
03100 DO BEGIN OUTSTR(↓&9&"FEATURE = ");
03200 STR ← INCHWL;
03300 F ← CVSI(STR,FLG);
03400 END UNTIL ¬FLG;
00100 α DISPLAY WHERE THE FEATURE IS SEEN WITH A DOT AND CROSS;
00200 GETBI;
00300 ∀ FWN|TVFILE⊗F≡FWN DO
00400 BEGIN "SEEN"
00500 REAL MX,MY;
00600 MX←∂(FWN)[1];
00700 MY←∂(FWN)[2];
00800 DOT(MX,MY);
00900 AI(MX+2,MY); AV(MX+4,MY);
01000 AI(MX-2,MY); AV(MX-4,MY);
01100 AI(MX,MY+2); AV(MX,MY+4);
01200 AI(MX,MY-2); AV(MX,MY-4);
01300 OUTSTR("FEATURE IS AT = "&CVG(MX)&9&CVG(MY)&↓);
01400 END "SEEN";
00100 α DISPLAY WHERE THE FEATURE SHOULD BE WITH A DOT AND CRISS;
00200 IF Q THEN
00300 BEGIN "CRISS"
00400 THRICE U[I] ← ∂(F)[I] - C[4,I];
00500 THRICE W[I] ← C[I,1]*U[1] + C[I,2]*U[2] + C[I,3]*U[3];
00600 IF W[3]<-FOCAL THEN
00700 BEGIN
00800 MX ← SCALX*W[1]/W[3];
00900 MY ← SCALY*W[2]/W[3];
01000 OUTSTR(" SHOULD BE AT = "&CVG(MX)&9&CVG(MY)&↓);
01100 DOT(MX,MY);
01200 AI(MX+2,MY+2); AV(MX+4,MY+4);
01300 AI(MX-2,MY-2); AV(MX-4,MY-4);
01400 AI(MX-2,MY+2); AV(MX-4,MY+4);
01500 AI(MX+2,MY-2); AV(MX+4,MY-4);
01600 END ELSE OUTSTR("BEHIND CAMERA."&↓);
01700 END "CRISS";
01800 α DATA DISC OUTPUT;
01900 GETDD;PLOWIN;RELARY(BIBUF);SETCHN(1);ERASDD(1);SHOWDD;
02000 RELARY(DDBUF);
02100 OUTSTR(↓&"*");
02200 END "SHOWFE";
02300 END "MARKER";